unit uLCDCharGen;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uBaseCalcForm, ExtCtrls, StdCtrls, ComCtrls;

type
  PLCDSymbol = ^TLCDSymbol;
  TLCDSymbol = array[0..7] of byte;

  TfmHD44780CG = class(TfmBaseCalcForm)
    Panel1: TPanel;
    imDisplay: TImage;
    edCString: TLabeledEdit;
    edB0: TLabeledEdit;
    edB1: TLabeledEdit;
    edB2: TLabeledEdit;
    edB3: TLabeledEdit;
    edB4: TLabeledEdit;
    edB5: TLabeledEdit;
    edB6: TLabeledEdit;
    edB7: TLabeledEdit;
    btnClear: TButton;
    btnFill: TButton;
    btnInverse: TButton;
    tvLibrary: TTreeView;
    btnLoadHex: TButton;
    edHexStr: TLabeledEdit;
    Label1: TLabel;
    cbCharSize: TComboBox;
    procedure imDisplayMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btnClearClick(Sender: TObject);
    procedure btnFillClick(Sender: TObject);
    procedure btnInverseClick(Sender: TObject);
    procedure edB0Change(Sender: TObject);
    procedure tvLibraryDeletion(Sender: TObject; Node: TTreeNode);
    procedure FormDestroy(Sender: TObject);
    procedure btnLoadHexClick(Sender: TObject);
    procedure tvLibraryDblClick(Sender: TObject);
    procedure cbCharSizeChange(Sender: TObject);
  private
    { Private declarations }
    CMask: TLCDSymbol;
    FChX,FChY: byte;
    bLock: boolean;
    procedure UpdateBitmap;
    procedure LoadLibrary;
  public
    { Public declarations }
    class function CalcFriendlyName: string; override;
    class function RunKey: string; override;
    class procedure InvokeCalc; override;

    procedure AfterConstruction; override;
  end;

var
  fmHD44780CG: TfmHD44780CG;

implementation

{$R *.dfm}

uses uFormReg, uLocalization, pxml;

function TrimEx(const S: string; Mask: string): string;
var I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (AnsiPos(S[I], Mask) > 0) do Inc(I);
  
  if I > L then Result := ''
  else begin
    while (AnsiPos(S[L], Mask) > 0) do Dec(L);
    Result := Copy(S, I, L - I + 1);
  end;
end;

function StrToIntDefEx(s: string; DefValue: integer): integer;
var i,l: integer;
begin
  Result := DefValue;
  s := Trim(s);
  if (s='') then exit;
  if SameText(Copy(s,1,2),'0x') then begin
    Delete(s,1,2);
    s := '$'+s;
  end;
  if SameText(Copy(s,1,2),'0b') then begin
    Result := 0;
    Delete(s,1,2);
    l := Length(s);
    i := 0;
    while (i<(l-1)) do begin
      if (s[l-i]='0') then Result := Result and (not (1 shl i))
      else Result := Result or (1 shl i);
      inc(i);
    end;
    exit;
  end;
  Result := StrToIntDef(s, DefValue);
end;

procedure CStringToSymbol(S: string; Sym: PLCDSymbol);
var i: integer;
    tmp: TLCDSymbol;
    buf: string;
begin
  i := 0;
  S := TrimEx(s,', ');
  while (s<>'') do begin
    if (i>7) then break;
    buf := NextToken(S, ',');
    buf := TrimEx(buf,', '#9);
    tmp[i] := StrToIntDefEx(buf,0);
    inc(i);
  end;
  Move(tmp, Sym^, SizeOf(TLCDSymbol));
end;

{ TfmHD44780CG }

procedure TfmHD44780CG.AfterConstruction;
var y: integer;
begin
  inherited;
  UpdateBitmap;
  for y := 0 to 7 do
    SetLabels('B'+IntToStr(y), 'Byte '+IntToStr(y),'');
  SetLabels('CString', GetLocaleString('cstring'), '');
  SetLabels('HexStr', GetLocaleString('hexstring'), '');
  bLock := false;

  btnClear.Caption := Self.GetLocaleString('doclear');
  btnFill.Caption := Self.GetLocaleString('dofill');
  btnInverse.Caption := Self.GetLocaleString('doinverse');
  btnLoadHex.Caption := Self.GetLocaleString('doloadhex');

  LocalizeStrings(cbCharSize.Items);

  tvLibrary.Items.Add(nil,GetLocaleString('libroot'));
  LoadLibrary;

  cbCharSize.ItemIndex := 1;
  cbCharSizeChange(nil);
end;

class function TfmHD44780CG.CalcFriendlyName: string;
begin
  Result := 'LCD Character Editor';
end;

class procedure TfmHD44780CG.InvokeCalc;
begin
  Application.CreateForm(TfmHD44780CG, fmHD44780CG);
  inherited;
end;

class function TfmHD44780CG.RunKey: string;
begin
  Result := 'lcdchar';
end;

procedure TfmHD44780CG.imDisplayMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  x := trunc((imDisplay.Width-X)/imDisplay.Width*5);
  y := trunc(Y/imDisplay.Height*8);
  if (y<FChY) then
    CMask[y] := CMask[y] xor (1 shl x);
  UpdateBitmap;
end;

procedure TfmHD44780CG.UpdateBitmap;
var x,y: integer;
    cw,ch: single;
    tmp: byte;
begin
  edHexStr.Text := '';
  with imDisplay.Picture.Bitmap do begin
    Width := imDisplay.Width;
    Height := imDisplay.Height;
    Canvas.Brush.Color := $0000FF80;
    Canvas.Pen.Color := $0000A000;
    Canvas.FillRect(Rect(0,0,Width,Height));

    cw := imDisplay.width/5;
    ch := imDisplay.Height/8;
    // Draw symbol
    Canvas.Brush.Color := $00002400;
    for y := 0 to 7 do begin
      if (y>FChY-1) then begin
        Canvas.Brush.Color := clBtnFace;
        Canvas.FillRect(Bounds(0, trunc(y*ch),
            imDisplay.Width, trunc(ch)));
      end else
      for x := 0 to FChX-1 do begin
        if (Boolean(CMask[y] and (1 shl x))) then begin
          // Draw square
          Canvas.FillRect(Bounds(
            imDisplay.width-trunc(x*cw+cw), trunc(y*ch),
            trunc(cw), trunc(ch)));
        end;
      end;
    end;

    // Draw grid
    Canvas.Pen.Color := $0000A000;
    for y := 1 to 7 do begin
      Canvas.MoveTo(0, trunc(y*ch));
      Canvas.LineTo(imDisplay.Width, trunc(y*ch));
    end;
    for x := 1 to 5 do begin
      Canvas.MoveTo(trunc(x*cw),0);
      Canvas.LineTo(trunc(x*cw), imDisplay.Height);
    end;
  end;

  // Update text fields
  if (cbCharSize.ItemIndex in [0,1]) then begin
    for y := 0 to 7 do
      edHexStr.Text := edHexStr.Text+Format('0x%.2x, ', [CMask[y]]);
  end else begin
    for x := 0 to 4 do begin
      tmp := 0;
      for y := 0 to 7 do begin
        if Boolean(CMask[y] and (1 shl x)) then tmp := tmp or (1 shl y);
      end;
      edHexStr.Text := Format('0x%.2x, ', [tmp])+edHexStr.Text;
    end;
  end;
  
  edHexStr.Text := TrimEx(edHexStr.Text,', ');
  edCString.Text := 'unsigned char sym[';
  if (cbCharSize.ItemIndex in [0,1]) then
    edCString.Text := edCString.Text+'8'
  else
    edCString.Text := edCString.Text+'5';
    
  edCString.Text := edCString.Text+'] = {'+edHexStr.Text+'};';
  bLock := true;
  edB0.Text := Format('0x%.2x', [CMask[0]]);
  edB1.Text := Format('0x%.2x', [CMask[1]]);
  edB2.Text := Format('0x%.2x', [CMask[2]]);
  edB3.Text := Format('0x%.2x', [CMask[3]]);
  edB4.Text := Format('0x%.2x', [CMask[4]]);
  edB5.Text := Format('0x%.2x', [CMask[5]]);
  edB6.Text := Format('0x%.2x', [CMask[6]]);
  edB7.Text := Format('0x%.2x', [CMask[7]]);
  bLock := false;
end;

procedure TfmHD44780CG.btnClearClick(Sender: TObject);
var y: integer;
begin
  for y := 0 to 7 do CMask[y] := 0;
  UpdateBitmap;
end;

procedure TfmHD44780CG.btnFillClick(Sender: TObject);
var y: integer;
begin
  for y := 0 to 7 do CMask[y] := $1F;
  UpdateBitmap;
end;

procedure TfmHD44780CG.btnInverseClick(Sender: TObject);
var y: integer;
begin
  for y := 0 to 7 do begin
    CMask[y] := CMask[y] xor $FF;
    CMask[y] := CMask[y] and $1F;
  end;
  UpdateBitmap;
end;

procedure TfmHD44780CG.edB0Change(Sender: TObject);
var s: string;
    tmp: byte;
begin
  if (bLock) then exit;
  
  s := TrimEx((Sender as TLabeledEdit).Text,' ,'#9);
  if (s='') then exit;
  if SameText(Copy(s,1,2),'0x') then begin
    Delete(s,1,2);
    s := '$'+s;
  end;
  if SameText(Copy(s,1,2),'0b') then begin
    exit;
  end;

  tmp := StrToIntDef(s,0) and $1F;
  CMask[(Sender as TLabeledEdit).Tag] := tmp;
  UpdateBitmap;
end;

procedure TfmHD44780CG.LoadLibrary;

    procedure _walk(xnode: TPXMLNode; tvnode: TTreeNode);
    var i: integer;
    begin
      for i := 0 to xnode.ChildCount-1 do begin
        if (WideSameText(xnode.Children[i].Name, 'group')) then begin
          _walk(xnode.Children[i], tvLibrary.Items.AddChild(tvNode, xNode.Children[i].getAttribute('name')));
        end else
        if (WideSameText(xnode.Children[i].Name, 'symbol')) then begin
          with tvLibrary.Items.AddChild(tvNode, xNode.Children[i].getAttribute('name')) do begin
            Data := AllocMem(sizeOf(TLCDSymbol));
            CStringToSymbol(xNode.Children[i].Value, PLCDSymbol(Data));
          end;
        end;
      end;
    end;

var lib: TPXMLDocument;
begin
  lib := TPXMLDocument.Create;
  try
    if (FileExists(AppDir+'Data\lcdchars.xml')) then lib.Load(AppDir+'Data\lcdchars.xml')
    else exit;
    if (lib.DocumentRoot<>nil) then
      _walk(lib.DocumentRoot, tvLibrary.Items[0]);
  finally lib.Free; end;
end;

procedure TfmHD44780CG.tvLibraryDeletion(Sender: TObject; Node: TTreeNode);
begin
  inherited;
  if (Node.Data<>nil) then FreeMem(Node.Data);
end;

procedure TfmHD44780CG.FormDestroy(Sender: TObject);
begin
  tvLibrary.Items.Clear;
  inherited;
end;

procedure TfmHD44780CG.btnLoadHexClick(Sender: TObject);
var s: string;
begin
  if InputQuery(GetLocaleString('doloadhex'),GetLocaleString('hload_prompt'), s) then begin
    CStringToSymbol(s, @CMask);
    UpdateBitmap;
  end;
end;

procedure TfmHD44780CG.tvLibraryDblClick(Sender: TObject);
begin
  if (tvLibrary.Selected=nil) then exit;
  if (tvLibrary.Selected.Data<>nil) then begin
    Move(tvLibrary.Selected.Data^, CMask, SizeOf(TLCDSymbol));
    UpdateBitmap;
  end;
end;

procedure TfmHD44780CG.cbCharSizeChange(Sender: TObject);
begin
  case cbCharSize.ItemIndex of
    0: begin
         FChX := 5;
         FChY := 7;
      end;
    1,2: begin
         FChX := 5;
         FChY := 8;
      end;
  end;
  UpdateBitmap;
end;

initialization
  RegisterCalc(TfmHD44780CG);

end.
